home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / Init.tcl.z / Init.tcl
Encoding:
Text File  |  1999-01-26  |  4.2 KB  |  164 lines
  1. # Init.tcl --
  2. #
  3. #    Initializes the Tix library and performes version checking to ensure
  4. #    the Tcl, Tk and Tix script libraries loaded matches with the binary
  5. #    of the respective packages.
  6. #
  7. # Copyright (c) 1996, Expert Interface Technologies
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12.  
  13. if ![tixStrEq $tix_library ""] {
  14.     global auto_path
  15.     lappend auto_path $tix_library
  16. }
  17.  
  18. if [catch {file join a a}] {
  19.     proc tixFileJoin {args} {
  20.     set p [join $args /]
  21.     regsub -all {/+} $p / p
  22.     return $p
  23.     }
  24. } else {
  25.     proc tixFileJoin {args} {
  26.     return [eval file join $args]
  27.    }
  28. }
  29.  
  30. proc __tixError {errorMsg} {
  31.     error [concat $errorMsg \
  32.        "Please check your TIX_LIBRARY environment variable and " \
  33.        "your Tix installation."]
  34. }
  35.  
  36. proc __tixInit {} {
  37.     global tix tixPriv env tix_version tix_patchLevel tk_version tix_library
  38.     global tcl_version
  39.  
  40.     if [info exists tix(initialized)] {
  41.     return
  42.     }
  43.     if {[info command "@scope"] != ""} {
  44.     set hasItcl 1
  45.     } else {
  46.     set hasItcl 0
  47.     }
  48.  
  49.     # STEP 0: Version checking using the Tcl7.5 package mechanism. This is not
  50.     #          done if we are linked to Tcl 7.4.
  51.     #
  52.     if [string compare [info command package] ""] {
  53.     if {![string comp [info command tixScriptVersion] ""] && 
  54.         ![auto_load tixScriptVersion]} {
  55.         __tixError [concat "Cannot determine version of Tix script " \
  56.         "library. Requires version $tix_version."]
  57.     }
  58.  
  59.     if !$hasItcl {
  60.         set pkgVersion  $tix_version.$tcl_version
  61.     } else {
  62.         # The extra .1 indicates that the Tix binary is specially
  63.         # compiled for Itcl. This is necessary for the "package
  64.         # require" command to load in the correct shared library
  65.         # file.
  66.         set pkgVersion  $tix_version.$tcl_version.1
  67.     }
  68.  
  69.     package provide Tix $pkgVersion
  70.     if [tixStrEq $tix_library ""] {
  71.         package provide Tixsam $pkgVersion
  72.     }
  73.     }
  74.  
  75.     # STEP 1: Version checking
  76.     #
  77.     #
  78.     if {![string compare [info command tixScriptVersion] ""] && 
  79.         ![auto_load tixScriptVersion]} {
  80.     __tixError [concat "Cannot determine version of Tix script library. "\
  81.         "Requires version $tix_version."]
  82.  
  83.     } elseif [string compare [tixScriptVersion] $tix_version] {
  84.     __tixError [concat "Tix script library version ([tixScriptVersion]) "\
  85.         "does not match binary version ($tix_version)"]
  86.  
  87.     } elseif [string compare [tixScriptPatchLevel] $tix_patchLevel] {
  88.     __tixError [concat "Tix script library patch-level "\
  89.         "([tixScriptPatchLevel]) does not match binary patch-level "\
  90.         "($tix_patchLevel)"]
  91.     }
  92.  
  93.     if [info exists errorMsg] {
  94.     error $errorMsg
  95.     }
  96.  
  97.     # STEP 2: Initialize file compatibility modules
  98.     #
  99.     #
  100.     if [info exists tixPriv(isWindows)] {
  101.     tixInitFileCmpt:Win
  102.     } elseif [info exists env(WINDOWS_EMU_DEBUG)] {
  103.     tixInitFileCmpt:Win
  104.     tixWinFileEmu
  105.     } else {
  106.     tixInitFileCmpt:Unix
  107.     }
  108.  
  109.     # STEP 3: Initialize the Tix application context
  110.     #
  111.     #
  112.  
  113.     tixAppContext tix
  114.  
  115.     # STEP 4: Initialize the bindings for widgets that are implemented in C
  116.     #
  117.     #
  118.     if [string compare [info command tixHList] ""] {
  119.     tixHListBind
  120.     }
  121.     if [string compare [info command tixTList] ""] {
  122.     tixTListBind
  123.     }
  124.     if [string compare [info command tixGrid]  ""] {
  125.     tixGridBind
  126.     }
  127.     tixComboBoxBind
  128.     tixControlBind
  129.     tixFloatEntryBind
  130.     tixLabelEntryBind
  131.     tixScrolledGridBind
  132.     tixScrolledListBoxBind
  133.  
  134.     # STEP 5: Some ITCL compatibility stuff
  135.     #
  136.     #
  137.     if $hasItcl {
  138.     rename update __update
  139.  
  140.     # We use $colon$colon as a hack here. The reason is, starting from
  141.     # Tix 4.0.6/4.1b1, all the double colons in Tix classnames have
  142.     # been replaced by a single colon by a sed script. This modification
  143.     # makes it possible to use Tix with ITCL without having to modify
  144.     # the ITCL core.  However, we don't want the real double colon
  145.     # (which means the global scope in ITCL) to be replaced.  The
  146.     # $colon$colon just by-passes the sed script.
  147.     #
  148.     proc update {args} {
  149.         set colon :
  150.         @scope $colon$colon eval __update $args
  151.     }
  152.  
  153.     rename tkwait __tkwait
  154.  
  155.     proc tkwait {args} {
  156.         set colon :
  157.         @scope $colon$colon eval __tkwait $args
  158.     }
  159.     }
  160.  
  161.     rename __tixError ""
  162.     rename __tixInit ""
  163. }
  164.